
{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}

module ORel.Storage where

import Data.Dynamic
import Data.Maybe
import qualified Data.Map as Map

import Control.Applicative
import Control.Monad.State

import ORel.Types
import ORel.ItemId
import ORel.Object
import ORel.Relation



newtype Item
    = Item (TypeRep, Dynamic)
    deriving Show

data Storage
    = Storage
        {lastItemId :: Integer
        ,itemStorage :: Map.Map ItemId Item
        }
    deriving Show

emptyStorage = Storage 0 Map.empty

type ORelMonad res = State Storage res


newObject :: ORelMonad (Object Nil)
newObject = do
    id <- lastItemId <$> get
    modify $ \st -> st {lastItemId = id + 1}
    return $ Object (ItemId id) Map.empty


newRelation :: relName -> ORelMonad (Relation relName)
newRelation _ = do
    id <- lastItemId <$> get
    modify $ \st -> st {lastItemId = id + 1}
    return $ Relation (ItemId id) Map.empty


class Storable a where
    store :: a -> ORelMonad a

instance Typeable typ => Storable (Object typ) where
    store obj@(Object id dat) = do
        let objRep = Item (typeOf (undefined :: typ), toDyn dat)
        modify $ \st -> st {itemStorage = Map.insert id objRep $ itemStorage st}
        return obj
   
instance Typeable relNm => Storable (Relation relNm) where
    store obj@(Relation id dat) = do
        let objRep = Item  (typeOf (undefined :: relNm), toDyn dat)
        modify $ \st -> st {itemStorage = Map.insert id objRep $ itemStorage st}
        return obj


getObject :: ItemId -> ORelMonad (Object typ)
getObject id = do
    itemStor <- itemStorage <$> get
    let Item (typRep, dat) = (Map.!) itemStor id
    -- TODO: add type check
    let objDat = fromDyn dat (error "not an object") :: Map.Map String Dynamic
    return $ Object id objDat


getRelation :: ItemId -> ORelMonad (Relation relNm)
getRelation id = do
    itemStor <- itemStorage <$> get
    let Item (typRep, dat) = (Map.!) itemStor id
    let relDat = fromDyn dat (error "not a relation") :: Map.Map String [ItemId]
    return $ Relation id relDat


navigate
    :: forall objTy relNm role1 role2.
        (Typeable relNm, Show role1, Show role2
        , Subtype objTy (PlayerType relNm role1))
    => Object objTy -> relNm -> role1 -> role2
    -> ORelMonad [Object (PlayerType relNm role2)]
{- FIXME
    fromDyn ничего не знает про нашу иерархию типов:
        id :: Sybtype t1 t2 => t1 -> t2
        id = fromDyn . toDyn
    в Storage нужно складывать не Dynamic, а пары (TypeRep, Map String Dynamic)

navigate obj relNm role1 role2 = do
    st <- itemStorage <$> get
    let rels = catMaybes $ map fromDynamic $ Map.elems st :: [Relation relNm]
    let joinedWithObj (Relation id rel) = (Map.!) (show role1) rel
    let rels' = filter joinedWithObj rels
    return []
-}
navigate obj relNm role1 role2 = return []



